knitr::opts_chunk$set(warning=FALSE, message=FALSE, error = FALSE)

Preparazione del dataset

# Importiamo tutte le librerie necessarie

library(jsonlite)
library(lubridate)
library(tidyverse)
library(gganimate)
library(purrr)
library(tsibble)
library(modelr)
library(riem)
library(weathermetrics)
library(chorddiag)

Con str(rawTG) vediamo che questo file JSON è una lista, di 3 elementi. Nel primo ci sono dati generali, negli altri due ci sono tutte le conversazioni di gruppo. Ogni elemento della lista è un dataframe, che a sua volta contiene liste e data frame. Estraiamo e ritagliamo fino ad avere solo quello che interessa a noi, il data frame della chat

setwd("~/Computer/R/affettiStabili")

rawTG<-fromJSON("result.json")


TG01<- rawTG[[4]]

# Trasformiamo in una tibble
TG01 <- as_tibble(TG01)

# eliminiamo tutti i partecipanti che hanno scritto meno di 20 messaggi

TG02<-group_by(TG01, from) %>% 
  filter(n()> 20) %>%
  ungroup()

colnames(TG02)[which(names(TG02) == "from")] <- "author"

# Rimuoviamo i messaggi di sistema (NA)

TG02 <- filter(TG02,
               !is.na(author))

# Campio anche il mio nick per allinearlo con gli altri (è più estetica che altro)

TG02$author[which(TG02$author == "arteteco")] <- "Psilocybe"

TG02 <- filter(TG02, author!="Quiz Bot")

Le colonne presenti sono:

Altro

Converrà convertire la colonna date in data type date

# sistemiamo il dataset per lavorare più comodamente con le date

TG05<-mutate(TG02,
    dateTime = parse_datetime(date, "%Y-%m-%dT%H:%M:%S"),
    year = year(dateTime),
    month = month(dateTime),
    day = day(dateTime),
    hour = hour(dateTime),
    minute = minute(dateTime),
    second = second(dateTime),
    date = date(dateTime)
  )

Descrizioni generali

A che ora si tende a scrivere?

Aff <- group_by(TG05, hour) %>%
  count() %>%
  arrange(desc(n))

ggplot(TG05) + 
  geom_density(color="darkblue", fill="lightblue", mapping=aes(x=hour, y=..scaled..))+
  geom_vline(aes(xintercept=mean(hour)),
            color="blue", linetype="dashed", size=1)+
  labs(x = "Ora")

L’ora di punta sono le 21.

Ci sono differenze individuali?

ggplot(TG05) + 
  geom_density(color="darkblue", fill="lightblue", mapping=aes(x=hour, y=..scaled..))+
  facet_wrap(author ~ .)+
  labs(x = "Ora")

Differenze nei mesi

byMonth <- mutate(TG05,
                  yearmonth = format((yearmonth(date)),  format = "%Y-%m"))

ggplot(byMonth) + 
  geom_density(color="darkblue", fill="lightblue", mapping=aes(x=hour, y=..scaled..))+
  facet_wrap(yearmonth ~ .)+
  labs(x = "Ora")

Messaggi totali

In generale, cogliamo l’occasione e visualizziamo un grafico cumulativo per settimana

history<-select(TG05, author, date, text)

history <- mutate(history,
                  yearWeek = yearweek(date)) %>%
  group_by(yearWeek, author) %>% 
  count() %>%
  group_by(author) %>%
  mutate (cumText = cumsum(n))

ggplot(history, aes(x=yearWeek, y=cumText, fill=author)) + 
  geom_area() +
  labs(x = "Settimana", y="Numero messaggi")

Network di risposte

Chi ha risposto a chi, e quanto?

È un grafico interattivo. Passando con il mouse sugli elementi si hanno informazioni

RepliedTo <- TG05 %>% 
  mutate(
    reply_to_author = author[match(reply_to_message_id, id)])

#A noi interessano solo 3 colonne: chi ha scritto, a chi, e quanto, e poi trasformarlo in matrice per plottarlo


RepliedTo <- filter(RepliedTo,
                    !is.na(reply_to_author)) %>%
  group_by(
    author, reply_to_author
  ) %>%
  count()

# prepariamoci il data frame per avere una matrice

RepliedTo <- pivot_wider(RepliedTo, names_from=reply_to_author, values_from=n)
RepliedTo[is.na(RepliedTo)] <- 0
RepliedToMatrix <- data.matrix(RepliedTo)
row.names(RepliedToMatrix) <- RepliedTo$author
RepliedToMatrix <- RepliedToMatrix[,-1]


# Ora, il grafico


groupColors <- c("#000000", "#FFDD89", "#957244", "#F26223", "#e4704b", "#90eb96", "#472c86", "#c3f729", "#004d8e", "#6d9db0", "#71b1e4", "#516afe")

nomi <- (dimnames(RepliedToMatrix)[[1]])

dimnames(RepliedToMatrix) <- list( autore = nomi,
                                   risposto = nomi)

p <- chorddiag(RepliedToMatrix, groupColors = groupColors, groupnamePadding = 20,showTicks = F)

p

Andamento

Quale sembra essere il futuro di questa chat? Iniziamo a fare una regressione sul numero di messaggi a settimana per farci un’idea

totText<-TG05 %>%
  group_by(date) %>%
  count()

modLm <- lm(n ~ date, data = totText)

gridLm <- add_predictions(totText, modLm)

ggplot(totText, aes(date)) +
  geom_point(aes(y = n)) +
  geom_line(aes(y = gridLm$pred), color = "blue", size = 1, method='lm')+
  labs(x = "Data", y="Numero Messaggi")

E con un modello loess

modLoess <- loess(n ~ as.numeric(date), data = totText)

gridLoess <- add_predictions(totText, modLoess)

ggplot(totText, aes(x=date, y=n)) +
  geom_point() +
  geom_smooth(aes(y = gridLoess$pred), size = 1, method='loess')+
  labs(x = "Data", y="Numero Messaggi")

Premi

All time

La persona che ha scritto di più

La cosa più scontata potrebbe essere fare una conta del numero di messaggi per persona.

NText<-TG05 %>% group_by(author)%>% drop_na(author) %>% count() %>% arrange(desc(n))

ggplot(data = NText) +
  geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=n, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1))+
   labs(x = "Autore", y="Numero Messaggi")

Il vincitore sembra Ramphastos, ma è davvero così? Molte persone tendono a separare i contenuti in più messaggi per qualche motivo.

Quindi, facciamo una conta dei caratteri inviati da ogni persona.

NChar<-group_by(TG05, author) %>%
  mutate(nChar = sum(nchar(text, type="chars", ), na.rm=TRUE)) %>%
  group_by(author, nChar) %>%
  group_keys() %>%
  arrange(desc(nChar))

ggplot(data = NChar) +
  geom_bar(mapping = aes(y = nChar, x = reorder(author, nChar), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=nChar, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1))+ 
  labs(x = "Autore", y="Numero Caratteri")

È ufficiale: Corvus è il vincitore.

Spin off: una prospettiva storica

Siamo nel 2020, e come omaggio ai tempi è d’obbligo un barplot race che non introduca nessuna informazione rilevante

# Vogliamo che ci sia sempre una riga per l'autore in ogni giorno, altrimenti il grafico sobbalza

rankHistory <- 
  complete(TG05, date, author) %>%
  group_by(date, author) %>%
  count() %>%
  group_by(author) %>%
  mutate (cumText = cumsum(n)) %>%
  group_by(date) %>%
  arrange(date, desc(cumText)) %>%
  mutate(rank = 1:n())

# Ora l'animazione

p <- rankHistory %>%
    ggplot(aes(x = -rank,y = cumText, group = author)) +
        geom_tile(aes(y = cumText / 2, height = cumText, fill = author), width = 0.9) +
        geom_text(aes(label = author), hjust = "right", colour = "black", fontface = "bold", nudge_y = -200) +
        geom_text(aes(label = scales::comma(cumText)), hjust = "left", nudge_y = 200, colour = "grey30") +
        coord_flip(clip="off") +
        scale_x_discrete("") +
        scale_y_continuous("",labels=scales::comma) +
        theme(panel.grid.major.y=element_blank(),
              panel.grid.minor.x=element_blank(),
              legend.position="none",
              plot.margin = margin(1,1,1,2,"cm"),
              axis.text.y=element_blank()) +
        # inizia la transizione
        transition_time(date) +
        ease_aes('cubic-in-out') +
        labs(title='Numero di messaggi il',
             subtitle=' {round(frame_time,0)}'
             )

animate(p, duration = 20, fps = 15, end_pause = 50, width = 800, height = 600)

Lo spezzettatore

Agganciandoci a prima, chi è che indulge nella barbaria di spezzettare continuamente i propri messaggi? Calcoliamoci la media di caratteri per messaggio.

Spez <- merge(NChar, NText, by = "author") %>%
  mutate(IS = n/nChar) %>%
  mutate(mediaCxT = nChar/n) %>%
  arrange(desc(IS))

  • Lo spezzettatore più grande è Pieris, con un indice di spezzettamento di 0.04 e una media di caratteri per messaggio di 21.4484493.

  • I messaggi in media più lunghi sono invece di Deb, lunghi 56.9318182 caratteri. La differenza non è enorme comunque.

Il più pigro (numero di vocali)

Chi invia più vocali o videomessaggi invece che messaggi scritti? Procediamo come prima

# Prendiamoci solo i messaggi che abbiano un vocale
NVoc<-TG05 %>%
  filter(media_type == "voice_message" | media_type == "video_message")

# Contiamoli raggruppati per autore
NVoc<-  group_by(NVoc, author)%>% 
  drop_na(author) %>% 
  count() %>% 
  arrange(desc(n))

# Plottiamo
ggplot(data = NVoc) +
  geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=n, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1)
  )+
  labs(x = "Numero Vocali", y="Autore")

Ramphastos sembra la persona che manda più video e audio messaggi.

Però il risultato andrebbe comparato al totale dei messaggi, quindi quanti messaggi vocali in proporzione?

NVoc <- rename(NVoc, nVoc = n)
NText <- rename(NText, nText = n)


NVocProp <- merge(NVoc, NText, by = "author") %>%
  mutate(prop = round(nText/nVoc, digits=2)) %>%
  arrange(prop)

ggplot(data = NVocProp) +
  geom_bar(mapping = aes(y = prop, x = reorder(author, -prop), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=prop, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1)
  )+
  labs(y = "Messaggi totale / vocali", x="Autore")

Scopriamo che il più pigro è in realtàUrsus, che invia un vocale o un video ogni 14.7 messaggi

Il risponditore

Abbiamo a disposizione una colonna di risposta ai messaggi: reply_to_message_id. Da qui è facile vedere chi risponde più spesso. A noi interessa sapere in rapporto ai messaggi inviati però

Nreplies<-TG05 %>% 
  filter(!is.na(reply_to_message_id)) %>%
  group_by(author)%>% 
  drop_na(author) %>% 
  count() %>% 
  rename(nReplies = n) %>%
  arrange(desc(nReplies))


NrepliesProp <- merge(Nreplies, NText, by = "author") %>%
  mutate(mediaRisposte = round(nText/nReplies),2) %>%
  arrange(desc(mediaRisposte))


ggplot(data = NrepliesProp) +
  geom_bar(mapping = aes(y = mediaRisposte, x = reorder(author, -mediaRisposte), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=mediaRisposte, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1)
  )+
  labs(x = "Autore", y="Totale messaggi / risposte")

Ramphastos è il maggior risponditore in assoluto, con risposte, ma rispetto ai messaggi complessivi dell’autore ci sono dei parimeriti. Di sicuro Ficus risponde di meno, con una media di una risposta ogni 19 messaggi.

Ma a chi risponde? Chi è che è il più risposto? Possiamo usare l’ID del messaggio nella colonna reply_to_message_id per risalire all’autore e vedere anche questo

messaggiRisposti<- TG05$reply_to_message_id
messaggiRisposti <- messaggiRisposti[!is.na(messaggiRisposti)]

MR<-filter(
  TG05,
  id %in% messaggiRisposti
  ) %>%
  group_by(author) %>%
  count() %>%
  arrange(desc(n))
  
  
ggplot(data = MR) +
  geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=n, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1)
  )+
  labs(y = "Messaggi a cui si ha avuto risposta", x="Autore")

Mensile

# filtriamo il dataset, vogliamo solo l'ultimo mese

TG06 <- mutate(TG05,
               yearmonth=yearmonth(date)) %>%
  filter(yearmonth==max(yearmonth)) %>%
           arrange(date)

Animazione del mese

rankHistory <- 
  complete(TG06, date, author) %>%
  group_by(date, author) %>%
  count() %>%
  group_by(author) %>%
  mutate (cumText = cumsum(n)) %>%
  group_by(date) %>%
  arrange(date, desc(cumText)) %>%
  mutate(rank = 1:n())

# Ora l'animazione

p <- rankHistory %>%
    ggplot(aes(x = -rank,y = cumText, group = author)) +
        geom_tile(aes(y = cumText / 2, height = cumText, fill = author), width = 0.9) +
        geom_text(aes(label = author), hjust = "right", colour = "black", fontface = "bold", nudge_y = -200) +
        geom_text(aes(label = scales::comma(cumText)), hjust = "left", nudge_y = 200, colour = "grey30") +
        coord_flip(clip="off") +
        scale_x_discrete("") +
        scale_y_continuous("",labels=scales::comma) +
        theme(panel.grid.major.y=element_blank(),
              panel.grid.minor.x=element_blank(),
              legend.position="none",
              plot.margin = margin(1,1,1,2,"cm"),
              axis.text.y=element_blank()) +
        # inizia la transizione
        transition_time(date) +
        ease_aes('cubic-in-out') +
        labs(title='Numero di messaggi il',
             subtitle=' {round(frame_time,0)}'
             )

animate(p, duration = 20, fps = 15, end_pause = 50, width = 800, height = 600)

TG06
## # A tibble: 1,324 x 36
##        id type  date       actor actor_id action title members text  photo width
##     <int> <chr> <date>     <chr>    <int> <chr>  <chr> <list>  <lis> <chr> <int>
##  1 120624 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>    178
##  2 120629 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
##  3 120634 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
##  4 120636 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
##  5 120640 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
##  6 120645 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
##  7 120646 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>    240
##  8 120647 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
##  9 120648 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
## 10 120649 mess… 2020-07-01 <NA>        NA <NA>   <NA>  <NULL>  <chr… <NA>     NA
## # … with 1,314 more rows, and 29 more variables: height <int>, author <chr>,
## #   from_id <int>, file <chr>, thumbnail <chr>, media_type <chr>,
## #   mime_type <chr>, duration_seconds <int>, reply_to_message_id <int>,
## #   sticker_emoji <chr>, location_information$latitude <dbl>, $longitude <dbl>,
## #   message_id <int>, forwarded_from <chr>, edited <chr>, via_bot <chr>,
## #   poll$question <chr>, $closed <lgl>, $total_voters <int>, $answers <list>,
## #   live_location_period_seconds <int>, dateTime <dttm>, year <dbl>,
## #   month <dbl>, day <int>, hour <int>, minute <int>, second <dbl>,
## #   yearmonth <mth>

Lo scrittore

NText<-TG06 %>% group_by(author)%>% drop_na(author) %>% count() %>% arrange(desc(n))

NChar<-group_by(TG06, author) %>%
  mutate(nChar = sum(nchar(text, type="chars", ), na.rm=TRUE)) %>%
  group_by(author, nChar) %>%
  group_keys() %>%
  arrange(desc(nChar))


ggplot(data = NText) +
  geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author), 
           stat = "identity")+
  coord_flip()+
  geom_text(stat='count',
            aes(label=n, x=author, group=author),
            hjust = -0.5, 
            size = 3,
            position = position_dodge(width = 1))+
   labs(x = "Autore", y="Numero Messaggi")

Il vincitore sembra Ramphastos!

La persona che ha scritto più caratteri è Ramphastos (E QUESTO È PIÙ IMPORTANTE)

Il chiaccherone

Chi ha parlato di più in bolle e vocali?

chiaccherone <- group_by(TG06, author) %>% summarize(lung = sum(duration_seconds, na.rm=TRUE)) %>% arrange(desc(lung))
chiaccherone
## # A tibble: 12 x 2
##    author        lung
##    <chr>        <int>
##  1 Ramphastos     283
##  2 Ursus          236
##  3 Rana           184
##  4 Pieris          54
##  5 Vitis           48
##  6 Ananas          45
##  7 Ficus           27
##  8 Corvus          15
##  9 Joe Lucrezia    14
## 10 Psilocybe       12
## 11 Parus            7
## 12 Phasianus        0

Ramphastos è il chiaccherone, con 283 secondi di messaggi vocali, bolle ecc.